perm filename RREAD.F4[1,LCS] blob sn#573310 filedate 1981-03-12 generic text, type T, neo UTF8
00200	      DIMENSION KNT(72),RI(72),I(72)
00500	1       FORMAT(72A1)
00600	2       FORMAT(' TYPE '$)
00700	4       FORMAT(20I3)
00800	200   FORMAT(1XA1/)
00900	201   FORMAT(F13.4/)
01000	100     WRITE(5,2)
01100	        READ(5,1)I
01200		CALL ASCINT(I,RI,KNT,M)
04200	      WRITE(5,4)(KNT(J),J=1,M)
04250		KK=-1
04300	      DO 11 K=1,M
04400	      IF(KNT(K).NE.0)GO TO 111
04450		WRITE(5,200)RI(K)
04475		IF(KK.LT.0)KK=K
04487		GO TO 11
04500	111    IF(KK.GT.0)CALL PAKIT(KK,K,RI)
04550		KK=-1
04575		WRITE(5,201)RI(K)
04587	11	CONTINUE
04590	       IF(KK.GT.0)CALL PAKIT(KK,K,RI)
04600	      GO TO 100
04700	        END
04800	
04900		SUBROUTINE PAKIT(KK,K,LET)
05000		DIMENSION LT(5),LET(1)
05100		J=K-KK
05200	2	JJ=J
05300		IF(JJ.GT.5)JJ=5
05310		DO 3 N=1,5
05320	3	LT(N)=' '
05325		NN=KK
05330		DO 4 N=1,5
05340		IF(LET(NN).EQ.' '.OR.LET(NN).GT.0)GO TO 5
05350		LT(N)=LET(NN)
05360	4	NN=NN+1
05400	5	CALL PACKX(JWD,LT)
05500		TYPE 1,JWD
05600		IF(JJ.EQ.J)RETURN
05700	1	FORMAT(1XA5/)
05800		J=J-JJ
05900		KK=KK+5
06000		GO TO 2
06100		END
18400		SUBROUTINE PACKX(NAM,KNM)
18500		DIMENSION KNM(5)
18600		DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
18700		1 , MM/"774000000000/
18800		NAM=0
18900		DO 12 K=5,1,-1
19000		NAM=NAM .OR. (KNM(K) .AND. MM)
19100		IF (K.EQ.1)RETURN
19200	17	IF (NAM.GE.0)GO TO 13
19300		NAM = (( NAM .AND. LL)/KK) .OR. JJ
19400		GO TO 12
19500	13	NAM = NAM / KK
19600	12	CONTINUE
19700		RETURN
19800		END